COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C**** MPRFAI.F4, PSRT (NOW A DUMMY)
C00025 ENDMK
C⊗;
C**** MPRFAI.F4, PSRT (NOW A DUMMY)

	SUBROUTINE MPRFAI
	IMPLICIT INTEGER(A-Q,S-Z)
	REAL XDIS,DIS,A,B,STFF,CENTR,POS,BOT,TOP,TOP2,TOTAL
	COMMON /DL/IXRX,SAVER,NAME,EXT /FRMT/F78F(1),FA1(1),FA5(1),ASK
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
CC	   ↓↓↓↓↓ V IS FOR READIN ONLY
	COMMON  /XRN/RN(1) /ALF/INP(72),ML
	1 /STF/RSTFAC(0/7),RSTJ2  /POSI/STFF(0/7),JJ2,POS
	1 /LIMIT/LIMIT,ITEM,L,I,M /DPY/GO,TOP,BOT
	1 /PTR/PWDS(1) /PLTR/PLT,RHT,DIS,XDIS
	EQUIVALENCE (J3,JQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(POS,IPOS)
	1,(R6,RJQ(4)),(R7,RJQ(5)),(R9,RJQ(7)),(J10,JQ(8)),(RX3,RJQ(20))
	1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1)),(R8,RJQ(6))
	DATA IP/'P'/,FA1/'( A1)'/

C MM←1↔NN←2↔J←3↔LL←4↔ AA←6↔Y←7↔V←10 ↔R←12↔RN←13↔K←14↔RB←15↔KK←11↔SY←5

	ITMS=0
	TOTAL=0
	RPLT=-999.
C  RPLT WILL BE FOR HEAVY STAFF LINES.
22	I1=0
2	TOP=-999.
	BOT=999.
20	PLT=0
	PLOTIT=0
	EDX=-1
	M=1
	GO TO 5504

11	CALL NOTWRT
57	IF(PLT)GO TO 6120
	ITEM=ITEM+1
	IF(EDX.EQ.-1)GO TO 77
   	IF(M.LT.I)GO TO 6120
77	IF(PLOTIT.EQ.-2)GO TO 2311
5504	IF(I1.EQ.IP)GO TO 2311
	I1=IP
	INP(2)='%'
C FLAG FOR 1ST TIME IN PLTCMD
311	JA=0
2311	NOSET=0
	CALL PLTCMD(NOSET)
	IF(INP(2).EQ.-1)GO TO 30
C  **** END OF DATA ***
	IF(PLOTIT.EQ.0)GO TO 3005
	I1=IP
	PLOTIT=-1
	M=1
	EDX=-1
	DO 5532 K=1,9
5532	JQ(K)=RJQ(K)
	IF(PLOTIT.EQ.-1)GO TO 5121
590	I1=0
C TO RUN THROUGH DATA.
	TOP=-999
	BOT=999
C GOES TO PLOTTER
85	M=1
	ITEM=0
	PLT=1
	EDX=0
	GO TO 6120

30	A=TOTAL/200.0
	CALL ENDIT(A,ITMS)
C  THE END OF THE DATA

60	J2=R2
	IF(J2.GE.8)GO TO 160
	IF(J2.GE.0)GO TO 16
160	CALL ILLEGL
	GO TO 57
16	RSTJ2=RSTFAC(J2)
	POS=STFF(J2)
	IF(JA.NE.16)GO TO 61
	IF(R5.GE.100.)R5=R5-100.
C >100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEP PARTS  
	IF(J10.NE.1)GO TO 62
	R3=RWD3
C  POSITIONS TEXT ITEMS.
62	RWD3=R5*RSTJ2*R9+R3
61	RX3=R3
	J3=ROFF(RHORZ(R3))
C  LINE IS DIVIDED INTO 200 POINTS.
	CALL CENTX
C  SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
	R3=J3
	IF(JA.LE.2)GO TO 11
	IF(JA.LE.18)GO TO 551
	CALL UNKNWN(JA)
C TRAP FOR UNKNOWN CODE #S (SUCH AS 99-FOR "NO KSIG".
	GO TO 57
C JA NEVER =13,14,15 AS YET.
551	GO TO(11,11,68,25,67, 625,116,125,11,69, 68,12,12,12,12
	1 ,116,81,80),JA

69	CALL MAKNUM(R5)
	GO TO 57
68	CALL CLEFS
	GO TO 57

67	CALL SLUR
	GO TO 57

116	CALL ALPHA
	GO TO 57

81	CALL KSIG
	GO TO 57

12	CALL CIRCLE
	GO TO 57
80	CALL METER
	GO TO 57
125	IF(R2.EQ.0)RMOV=R8
	CALL STAFF
	GO TO 57
625	CALL BEAMX
	GO TO 57

25	CALL ITMSUB
C  BAR LINES AND SEVERAL OTHER KINDS OF LINES.
	GO TO 57

3005	IF(RPLT.EQ.-999.)RPLT=R9
C R9=1 FOR HEAVY STAFF LINES. (FOR XGP)
	PLOTIT=-2
	IF(ITMS.NE.0.OR.NOSET.NE.0)GO TO 3006
C FIRST TIME CHECK FOR NOSET FLAG
C NOSET=-1 IF NOSET IS ON
	TOP2=-999.
	RNOMOV=0
3006	CALL INMUS(NAME,EXT,RN,PWDS,RSTFAC)
C INMUS READS OLD OOR NEW FORMAT
C NEW FORMAT AVOIDS 2ND EXTIN CALL
	ITEM=JJ2-2
	ITMS=ITMS+ITEM
	I=IPOS
2203	IF(I.LE.3000)GO TO 590
	CALL TOOMCH(I)
C ***** TOO MUCH DATA ',I4,'/2000')
121	IF(PLOTIT.EQ.0)GO TO 5504
CC*** ONLY NEEDED WITH PLOTTER 5121	CALL PSRT
CC BUT MUST MOVE RN DATA TO RN(3000)  NOIR USES RN(1-1500)
CCC5121	DO 5120 K=1,I
CCC5120	RN(K+2999)=RN(K)
CCC	DO 5122 K=1,ITEM+1
CCC5122	PWDS(K)=PWDS(K)+2999
CCC	M=3000
CCC	I=I+2999
C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
C;;;;;;;;;; HEAVY STAFF LINE FEATURE DISABLED 7/23/79 ;;;;;;;;;;;;;;
C;;	SKIPE RPLT		;	PLT=-1
C;;	SOS PLTR		;	IF(RPLT.NE.0)PLT=-2
C;;;;;;;;;; HEAVY STAFF LINE FEATURE DISABLED 7/23/79 ;;;;;;;;;;;;;;
C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
5121	PLT=-1
	DIS=R2*1.24
	XDIS=1./DIS
	RHT=R3*1.2
C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT

C FIRST TIME RMOV=0 OR +
	IAC=0
 	IF(RMOV.NE.0)GO TO 701
	IAC=-1 
C  SET AC3 (FLAG) TO -1
	TOTAL=TOTAL+(TOP-BOT)*RHT
C TOTAL=TOTAL IMAGE LENGTH (IN 200THS INCH)

701	A=BOT*RHT
C ??????
	BOT=-A
	IF(IAC.LT.0)GO TO 702
	IF(RMOV.GT.0)GO TO 703
	IF(TOTAL.EQ.0)TOTAL=BOT
703	TOTAL=TOTAL+TOP*RHT
C TOTAL includes BOT with first file only.
702	IF(TOP2.EQ.-999)GO TO 8121
	BOT=BOT+TOP2
	IF(TOP2.EQ.0)BOT=0
	A=BOT
	GO TO 9121
8121	RNOMOV=0
9121	IF(R7.EQ.0)R7=RMOV
C RMOV HAS INCHES FROM P8 OF STAFF 0.
	IF(RNOMOV.GT.1)BOT=RNOMOV
	RNOMOV=200.*R3
	IF(R7.GE.0)RNOMOV=RNOMOV*R7
	RNOMOV=RNOMOV+R6
	RMOV=-1
C  THIS IS AFTER 1ST TIME.
C  R6=1 FOR NO MOVE AT END.  R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
C (J4) P4=1 FOR XGP OUTPUT
	IF(J5.NE.0)GO TO 6120
C  MOVES 0 POINT OVER EACH TIME.
6121	CALL PLOT(0,IFIX(BOT),-3)
C  MOVES PLOTTER UP IF P5=0.

C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
6120	IF(M.GE.I)GO TO 7120
	CALL RUNTHR(M)
	GO TO 60
7120	M=1
 	A=50.*RHT
	TOP=TOP*RHT
	IF(RNOMOV.EQ.0)GO TO 7122
	A=0
7121	IF(RNOMOV.LE.1)GO TO 7123
	A=RNOMOV
	TOTAL=TOTAL+A-TOP
	GO TO 7123
7122	TOTAL=TOTAL+A
	A=A+TOP
7123	CALL PLOT(0,IFIX(A),3)
	IF(RNOMOV.EQ.1)GO TO 20
C  PRESERVES TOP AND BOT IF RNOMOV
	TOP=A
	TOP2=TOP
	GO TO 2
C   ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
	END

C PPP:	BLOCK =350	;THIS WAS 250 - 2/78, 6/78

C ;;	SUBROUTINE PSRT(P)
C ;; SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
C ;;	IMPLICIT INTEGER(S-Z)
C ;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
C ;;	DIMENSION  P(250) **** AN ARGUMENT, INSTEAD.
C PSRT:	0	;	DO 4 K=1,ITEM
C 	MOVEI	K,PPP		; ADR OF P
C 	MOVEI	MM,PTR		;L=PWDS(K)
C 	MOVEI RB,(MM)
C 	MOVE	NN,LIMIT+1  	; ITEM
C ;;	MOVE	NN,PTR+=250	; ITEM
C 	ADDI	NN,-1(MM)		; LAST ADR. OF PWDS
C 	MOVE SY,[16.0]
C PL4:	MOVE	R,(MM)		;LL=PWDS(K-1)
C 				;LM=PWDS(K+1)
C 				;A=RN(L+3)
C 				;P(K)=A+1000*RN(L+2)
C 	MOVE AA,XRN+2(R)
C 	MOVE J,XRN+1(R)
C 	FMPR	J,[=1000.0]
C 	FADR	J,XRN+2(R)	; IF(RN(L+1).NE.16)GO TO 40
C 	MOVE V,XRN(R)
C 	CAME	V,[=8.0]	;IF(RN(L+1).EQ.8)P(X)=P(X)-16
C 	JRST	PLA
C 	FSBR	J,[=16.0]
C 	MOVE	AA,[=1000.0]
C PLA:	MOVEM	J,(K)
C 	CAME V,SY
C 	JRST	PL40
C 	CAIN RB,(MM)
C 	JRST PLAQ		;IF (K.EQ.1) GO TO PLAQ
C 	MOVE	Y,-1(MM)	;Y=PWDS(K-1)
C 	CAMN SY,XRN(Y)
C 	JRST 	PL41
C PLAQ:	MOVE	V,1(MM)		;V=PWDS(K+1) ;IF(RN(V+1).EQ.16)GO TO 41
C 	CAMN SY,XRN(V)
C 	JRST	PL41
C 	JRST	PLS		;GO TO 4
C PL40:	JUMPGE	AA,PLS 	;40	IF(A.GE.0)GO TO 4
C PL41:	MOVN	AA,[=10000.0]	;41	P(K)=-10000
C 	MOVEM	AA,(K)
C PLS:	CAIL	MM,(NN)	;4	CONTINUE
C 	JRST	PLX
C 	AOJ	MM,
C 	AOJA	K,PL4
C ;  PLOTS ALL NEG. POSITIONS FIRST.
C PLX:	MOVE	AA,LIMIT+3  	;IX=I
C 	MOVEM	AA,LIMIT+4  
C 	CAIL	AA,=3000		;IF(I.LT.1500)I=1500
C ;;6/78	CAIL	AA,=1500		;IF(I.LT.1500)I=1500
C 	JRST 	PLY
C 	MOVEI	AA,=3000
C ;;6/78	MOVEI	AA,=1500
C 	MOVEM	AA,LIMIT+3 
C PLY:	MOVEI	Y,(AA)		;	Y=I
C 	ADD	AA,LIMIT+4 	;I=I+IX-1
C 	SUBI	AA,1
C 	MOVEM	AA,LIMIT+3 
C 	MOVEM	Y,LIMIT+4 	;IX=Y
C ;  IX IS M IN MAIN PROG.
C ;  LEAVES 1500 WDS IN RN FOR STORING "NOIR" DATA.
C PL2:	MOVE	AA,PPP  		;2	A=P(1)
C 	MOVEI	R,1		;L=1
C 	MOVEI	J,1
C 	MOVEI	K,PPP  		;DO 1 K=1,ITEM
C 	MOVE	NN,LIMIT+1 
C 	ADDI	NN,(K)	;P(ITEM)
C PL1:	CAMG	AA,(K)		;IF(A.LE.P(K))GO TO 1
C 	JRST	PLZ
C 	MOVE	AA,(K)		;A=P(K)
C 	MOVE	R,J		;L=K
C PLZ:	CAIL	K,-1(NN)	;1	CONTINUE
C 	JRST	PLW
C 	AOJ	K,
C 	AOJA	J,PL1
C PLW:	CAMN	AA,[=10000.0]	;	IF(A.EQ.10000.)RETURN
C 	JRA	16,(16)
C ;  ALL ITEMS HAVE NOW BEEN SHUFFLED
C 	MOVEI	V,PTR		;V=PWDS(L)
C 	ADDI	V,(R)
C 	MOVE	V,-1(V)
C 	MOVE	AA,[=10000.0]	;P(L)=10000
C 	MOVEI	J,PPP  
C 	ADDI	J,(R)
C 	MOVEM	AA,-1(J)
C 	MOVEI	R,XRN		;L=RN(V)+2+Y
C 	ADDI	R,(V)
C 	KIFIX	R,-1(R)
C 	ADDI	R,2
C 	ADDI	R,(Y)
C 	SUBI	V,(Y)		;V=V-Y
C 	MOVEI	K,XRN		;DO 3 K=Y,L
C 	ADDI	K,(Y)
C 	MOVEI	NN,XRN
C 	ADDI	NN,(R)
C PL3:	MOVEI	AA,(K)
C 	ADDI	AA,(V)		;3	RN(K)=RN(K+V)
C 	MOVE	AA,-1(AA)
C 	MOVEM	AA,-1(K)
C 	CAIGE	K,(NN)
C 	AOJA	K,PL3
C ;; REPLACED SUBROUTINE LOOP
C 	MOVEI	Y,(R)		;Y=L+1
C 	ADDI	Y,1
C 	JRST	PL2		;GO TO 2
C 	END